home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl-5.003.tar.gz / perl-5.003.tar / perl-5.003 / doop.c < prev    next >
C/C++ Source or Header  |  1996-01-26  |  13KB  |  685 lines
  1. /*    doop.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "'So that was the job I felt I had to do when I started,' thought Sam."
  12.  */
  13.  
  14. #include "EXTERN.h"
  15. #include "perl.h"
  16.  
  17. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  18. #include <signal.h>
  19. #endif
  20.  
  21. #ifdef BUGGY_MSC
  22.  #pragma function(memcmp)
  23. #endif /* BUGGY_MSC */
  24.  
  25. #ifdef BUGGY_MSC
  26.  #pragma intrinsic(memcmp)
  27. #endif /* BUGGY_MSC */
  28.  
  29. I32
  30. do_trans(sv,arg)
  31. SV *sv;
  32. OP *arg;
  33. {
  34.     register short *tbl;
  35.     register U8 *s;
  36.     register U8 *send;
  37.     register U8 *d;
  38.     register I32 ch;
  39.     register I32 matches = 0;
  40.     register I32 squash = op->op_private & OPpTRANS_SQUASH;
  41.     STRLEN len;
  42.  
  43.     if (SvREADONLY(sv))
  44.     croak(no_modify);
  45.     tbl = (short*)cPVOP->op_pv;
  46.     s = (U8*)SvPV(sv, len);
  47.     if (!len)
  48.     return 0;
  49.     if (!SvPOKp(sv))
  50.     s = (U8*)SvPV_force(sv, len);
  51.     (void)SvPOK_only(sv);
  52.     send = s + len;
  53.     if (!tbl || !s)
  54.     croak("panic: do_trans");
  55.     DEBUG_t( deb("2.TBL\n"));
  56.     if (!op->op_private) {
  57.     while (s < send) {
  58.         if ((ch = tbl[*s]) >= 0) {
  59.         matches++;
  60.         *s = ch;
  61.         }
  62.         s++;
  63.     }
  64.     }
  65.     else {
  66.     d = s;
  67.     while (s < send) {
  68.         if ((ch = tbl[*s]) >= 0) {
  69.         *d = ch;
  70.         if (matches++ && squash) {
  71.             if (d[-1] == *d)
  72.             matches--;
  73.             else
  74.             d++;
  75.         }
  76.         else
  77.             d++;
  78.         }
  79.         else if (ch == -1)        /* -1 is unmapped character */
  80.         *d++ = *s;        /* -2 is delete character */
  81.         s++;
  82.     }
  83.     matches += send - d;    /* account for disappeared chars */
  84.     *d = '\0';
  85.     SvCUR_set(sv, d - (U8*)SvPVX(sv));
  86.     }
  87.     SvSETMAGIC(sv);
  88.     return matches;
  89. }
  90.  
  91. void
  92. do_join(sv,del,mark,sp)
  93. register SV *sv;
  94. SV *del;
  95. register SV **mark;
  96. register SV **sp;
  97. {
  98.     SV **oldmark = mark;
  99.     register I32 items = sp - mark;
  100.     register STRLEN len;
  101.     STRLEN delimlen;
  102.     register char *delim = SvPV(del, delimlen);
  103.     STRLEN tmplen;
  104.  
  105.     mark++;
  106.     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
  107.     if (SvTYPE(sv) < SVt_PV)
  108.     sv_upgrade(sv, SVt_PV);
  109.     if (SvLEN(sv) < len + items) {    /* current length is way too short */
  110.     while (items-- > 0) {
  111.         if (*mark) {
  112.         SvPV(*mark, tmplen);
  113.         len += tmplen;
  114.         }
  115.         mark++;
  116.     }
  117.     SvGROW(sv, len + 1);        /* so try to pre-extend */
  118.  
  119.     mark = oldmark;
  120.     items = sp - mark;;
  121.     ++mark;
  122.     }
  123.  
  124.     if (items-- > 0) {
  125.     char *s;
  126.  
  127.     if (*mark) {
  128.         s = SvPV(*mark, tmplen);
  129.         sv_setpvn(sv, s, tmplen);
  130.     }
  131.     else
  132.         sv_setpv(sv, "");
  133.     mark++;
  134.     }
  135.     else
  136.     sv_setpv(sv,"");
  137.     len = delimlen;
  138.     if (len) {
  139.     for (; items > 0; items--,mark++) {
  140.         sv_catpvn(sv,delim,len);
  141.         sv_catsv(sv,*mark);
  142.     }
  143.     }
  144.     else {
  145.     for (; items > 0; items--,mark++)
  146.         sv_catsv(sv,*mark);
  147.     }
  148.     SvSETMAGIC(sv);
  149. }
  150.  
  151. void
  152. do_sprintf(sv,len,sarg)
  153. register SV *sv;
  154. register I32 len;
  155. register SV **sarg;
  156. {
  157.     register char *s;
  158.     register char *t;
  159.     register char *f;
  160.     bool dolong;
  161. #ifdef HAS_QUAD
  162.     bool doquad;
  163. #endif /* HAS_QUAD */
  164.     char ch;
  165.     register char *send;
  166.     register SV *arg;
  167.     char *xs;
  168.     I32 xlen;
  169.     I32 pre;
  170.     I32 post;
  171.     double value;
  172.     STRLEN arglen;
  173.  
  174.     sv_setpv(sv,"");
  175.     len--;            /* don't count pattern string */
  176.     t = s = SvPV(*sarg, arglen);    /* XXX Don't know t is writeable */
  177.     send = s + arglen;
  178.     sarg++;
  179.     for ( ; ; len--) {
  180.  
  181.     /*SUPPRESS 560*/
  182.     if (len <= 0 || !(arg = *sarg++))
  183.         arg = &sv_no;
  184.  
  185.     /*SUPPRESS 530*/
  186.     for ( ; t < send && *t != '%'; t++) ;
  187.     if (t >= send)
  188.         break;        /* end of run_format string, ignore extra args */
  189.     f = t;
  190.     *buf = '\0';
  191.     xs = buf;
  192. #ifdef HAS_QUAD
  193.     doquad =
  194. #endif /* HAS_QUAD */
  195.     dolong = FALSE;
  196.     pre = post = 0;
  197.     for (t++; t < send; t++) {
  198.         switch (*t) {
  199.         default:
  200.         ch = *(++t);
  201.         *t = '\0';
  202.         (void)sprintf(xs,f);
  203.         len++, sarg--;
  204.         xlen = strlen(xs);
  205.         break;
  206.         case 'n': case '*':
  207.         croak("Use of %c in printf format not supported", *t);
  208.  
  209.         case '0': case '1': case '2': case '3': case '4':
  210.         case '5': case '6': case '7': case '8': case '9': 
  211.         case '.': case '#': case '-': case '+': case ' ':
  212.         continue;
  213.         case 'l':
  214. #ifdef HAS_QUAD
  215.         if (dolong) {
  216.             dolong = FALSE;
  217.             doquad = TRUE;
  218.         } else
  219. #endif
  220.         dolong = TRUE;
  221.         continue;
  222.         case 'c':
  223.         ch = *(++t);
  224.         *t = '\0';
  225.         xlen = SvIV(arg);
  226.         if (strEQ(f,"%c")) { /* some printfs fail on null chars */
  227.             *xs = xlen;
  228.             xs[1] = '\0';
  229.             xlen = 1;
  230.         }
  231.         else {
  232.             (void)sprintf(xs,f,xlen);
  233.             xlen = strlen(xs);
  234.         }
  235.         break;
  236.         case 'D':
  237.         dolong = TRUE;
  238.         /* FALL THROUGH */
  239.         case 'd':
  240.         ch = *(++t);
  241.         *t = '\0';
  242. #ifdef HAS_QUAD
  243.         if (doquad)
  244.             (void)sprintf(buf,s,(Quad_t)SvNV(arg));
  245.         else
  246. #endif
  247.         if (dolong)
  248.             (void)sprintf(xs,f,(long)SvNV(arg));
  249.         else
  250.             (void)sprintf(xs,f,SvIV(arg));
  251.         xlen = strlen(xs);
  252.         break;
  253.         case 'X': case 'O':
  254.         dolong = TRUE;
  255.         /* FALL THROUGH */
  256.         case 'x': case 'o': case 'u':
  257.         ch = *(++t);
  258.         *t = '\0';
  259.         value = SvNV(arg);
  260. #ifdef HAS_QUAD
  261.         if (doquad)
  262.             (void)sprintf(buf,s,(unsigned Quad_t)value);
  263.         else
  264. #endif
  265.         if (dolong)
  266.             (void)sprintf(xs,f,U_L(value));
  267.         else
  268.             (void)sprintf(xs,f,U_I(value));
  269.         xlen = strlen(xs);
  270.         break;
  271.         case 'E': case 'e': case 'f': case 'G': case 'g':
  272.         ch = *(++t);
  273.         *t = '\0';
  274.         (void)sprintf(xs,f,SvNV(arg));
  275.         xlen = strlen(xs);
  276.         break;
  277.         case 's':
  278.         ch = *(++t);
  279.         *t = '\0';
  280.         xs = SvPV(arg, arglen);
  281.         xlen = (I32)arglen;
  282.         if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
  283.             break;        /* so handle simple cases */
  284.         }
  285.         else if (f[1] == '-') {
  286.             char *mp = strchr(f, '.');
  287.             I32 min = atoi(f+2);
  288.  
  289.             if (mp) {
  290.             I32 max = atoi(mp+1);
  291.  
  292.             if (xlen > max)
  293.                 xlen = max;
  294.             }
  295.             if (xlen < min)
  296.             post = min - xlen;
  297.             break;
  298.         }
  299.         else if (isDIGIT(f[1])) {
  300.             char *mp = strchr(f, '.');
  301.             I32 min = atoi(f+1);
  302.  
  303.             if (mp) {
  304.             I32 max = atoi(mp+1);
  305.  
  306.             if (xlen > max)
  307.                 xlen = max;
  308.             }
  309.             if (xlen < min)
  310.             pre = min - xlen;
  311.             break;
  312.         }
  313.         strcpy(tokenbuf+64,f);    /* sprintf($s,...$s...) */
  314.         *t = ch;
  315.         (void)sprintf(buf,tokenbuf+64,xs);
  316.         xs = buf;
  317.         xlen = strlen(xs);
  318.         break;
  319.         }
  320.         /* end of switch, copy results */
  321.         *t = ch;
  322.         if (xs == buf && xlen >= sizeof(buf)) {    /* Ooops! */
  323.         fputs("panic: sprintf overflow - memory corrupted!\n",stderr);
  324.         my_exit(1);
  325.         }
  326.         SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
  327.         sv_catpvn(sv, s, f - s);
  328.         if (pre) {
  329.         repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
  330.         SvCUR(sv) += pre;
  331.         }
  332.         sv_catpvn(sv, xs, xlen);
  333.         if (post) {
  334.         repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
  335.         SvCUR(sv) += post;
  336.         }
  337.         s = t;
  338.         break;        /* break from for loop */
  339.     }
  340.     }
  341.     sv_catpvn(sv, s, t - s);
  342.     SvSETMAGIC(sv);
  343. }
  344.  
  345. void
  346. do_vecset(sv)
  347. SV *sv;
  348. {
  349.     SV *targ = LvTARG(sv);
  350.     register I32 offset;
  351.     register I32 size;
  352.     register unsigned char *s;
  353.     register unsigned long lval;
  354.     I32 mask;
  355.     STRLEN targlen;
  356.     STRLEN len;
  357.  
  358.     if (!targ)
  359.     return;
  360.     s = (unsigned char*)SvPV_force(targ, targlen);
  361.     lval = U_L(SvNV(sv));
  362.     offset = LvTARGOFF(sv);
  363.     size = LvTARGLEN(sv);
  364.     
  365.     len = (offset + size + 7) / 8;
  366.     if (len > targlen) {
  367.     s = (unsigned char*)SvGROW(targ, len + 1);
  368.     (void)memzero(s + targlen, len - targlen + 1);
  369.     SvCUR_set(targ, len);
  370.     }
  371.     
  372.     if (size < 8) {
  373.     mask = (1 << size) - 1;
  374.     size = offset & 7;
  375.     lval &= mask;
  376.     offset >>= 3;
  377.     s[offset] &= ~(mask << size);
  378.     s[offset] |= lval << size;
  379.     }
  380.     else {
  381.     offset >>= 3;
  382.     if (size == 8)
  383.         s[offset] = lval & 255;
  384.     else if (size == 16) {
  385.         s[offset] = (lval >> 8) & 255;
  386.         s[offset+1] = lval & 255;
  387.     }
  388.     else if (size == 32) {
  389.         s[offset] = (lval >> 24) & 255;
  390.         s[offset+1] = (lval >> 16) & 255;
  391.         s[offset+2] = (lval >> 8) & 255;
  392.         s[offset+3] = lval & 255;
  393.     }
  394.     }
  395. }
  396.  
  397. void
  398. do_chop(astr,sv)
  399. register SV *astr;
  400. register SV *sv;
  401. {
  402.     STRLEN len;
  403.     char *s;
  404.     
  405.     if (SvTYPE(sv) == SVt_PVAV) {
  406.     register I32 i;
  407.         I32 max;
  408.     AV* av = (AV*)sv;
  409.         max = AvFILL(av);
  410.         for (i = 0; i <= max; i++) {
  411.         sv = (SV*)av_fetch(av, i, FALSE);
  412.         if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
  413.         do_chop(astr, sv);
  414.     }
  415.         return;
  416.     }
  417.     if (SvTYPE(sv) == SVt_PVHV) {
  418.         HV* hv = (HV*)sv;
  419.     HE* entry;
  420.         (void)hv_iterinit(hv);
  421.         /*SUPPRESS 560*/
  422.         while (entry = hv_iternext(hv))
  423.             do_chop(astr,hv_iterval(hv,entry));
  424.         return;
  425.     }
  426.     s = SvPV(sv, len);
  427.     if (len && !SvPOK(sv))
  428.     s = SvPV_force(sv, len);
  429.     if (s && len) {
  430.     s += --len;
  431.     sv_setpvn(astr, s, 1);
  432.     *s = '\0';
  433.     SvCUR_set(sv, len);
  434.     SvNIOK_off(sv);
  435.     }
  436.     else
  437.     sv_setpvn(astr, "", 0);
  438.     SvSETMAGIC(sv);
  439. } 
  440.  
  441. I32
  442. do_chomp(sv)
  443. register SV *sv;
  444. {
  445.     register I32 count;
  446.     STRLEN len;
  447.     char *s;
  448.  
  449.     if (RsSNARF(rs))
  450.     return 0;
  451.     count = 0;
  452.     if (SvTYPE(sv) == SVt_PVAV) {
  453.     register I32 i;
  454.         I32 max;
  455.     AV* av = (AV*)sv;
  456.         max = AvFILL(av);
  457.         for (i = 0; i <= max; i++) {
  458.         sv = (SV*)av_fetch(av, i, FALSE);
  459.         if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
  460.         count += do_chomp(sv);
  461.     }
  462.         return count;
  463.     }
  464.     if (SvTYPE(sv) == SVt_PVHV) {
  465.         HV* hv = (HV*)sv;
  466.     HE* entry;
  467.         (void)hv_iterinit(hv);
  468.         /*SUPPRESS 560*/
  469.         while (entry = hv_iternext(hv))
  470.             count += do_chomp(hv_iterval(hv,entry));
  471.         return count;
  472.     }
  473.     s = SvPV(sv, len);
  474.     if (len && !SvPOKp(sv))
  475.     s = SvPV_force(sv, len);
  476.     if (s && len) {
  477.     s += --len;
  478.     if (RsPARA(rs)) {
  479.         if (*s != '\n')
  480.         goto nope;
  481.         ++count;
  482.         while (len && s[-1] == '\n') {
  483.         --len;
  484.         --s;
  485.         ++count;
  486.         }
  487.     }
  488.     else {
  489.         STRLEN rslen;
  490.         char *rsptr = SvPV(rs, rslen);
  491.         if (rslen == 1) {
  492.         if (*s != *rsptr)
  493.             goto nope;
  494.         ++count;
  495.         }
  496.         else {
  497.         if (len < rslen)
  498.             goto nope;
  499.         len -= rslen - 1;
  500.         s -= rslen - 1;
  501.         if (bcmp(s, rsptr, rslen))
  502.             goto nope;
  503.         count += rslen;
  504.         }
  505.     }
  506.     *s = '\0';
  507.     SvCUR_set(sv, len);
  508.     SvNIOK_off(sv);
  509.     }
  510.   nope:
  511.     SvSETMAGIC(sv);
  512.     return count;
  513. } 
  514.  
  515. void
  516. do_vop(optype,sv,left,right)
  517. I32 optype;
  518. SV *sv;
  519. SV *left;
  520. SV *right;
  521. {
  522. #ifdef LIBERAL
  523.     register long *dl;
  524.     register long *ll;
  525.     register long *rl;
  526. #endif
  527.     register char *dc;
  528.     STRLEN leftlen;
  529.     STRLEN rightlen;
  530.     register char *lc = SvPV(left, leftlen);
  531.     register char *rc = SvPV(right, rightlen);
  532.     register I32 len;
  533.     I32 lensave;
  534.  
  535.     dc = SvPV_force(sv,na);
  536.     len = leftlen < rightlen ? leftlen : rightlen;
  537.     lensave = len;
  538.     if (SvCUR(sv) < len) {
  539.     dc = SvGROW(sv,len + 1);
  540.     (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
  541.     }
  542.     SvCUR_set(sv, len);
  543.     (void)SvPOK_only(sv);
  544. #ifdef LIBERAL
  545.     if (len >= sizeof(long)*4 &&
  546.     !((long)dc % sizeof(long)) &&
  547.     !((long)lc % sizeof(long)) &&
  548.     !((long)rc % sizeof(long)))    /* It's almost always aligned... */
  549.     {
  550.     I32 remainder = len % (sizeof(long)*4);
  551.     len /= (sizeof(long)*4);
  552.  
  553.     dl = (long*)dc;
  554.     ll = (long*)lc;
  555.     rl = (long*)rc;
  556.  
  557.     switch (optype) {
  558.     case OP_BIT_AND:
  559.         while (len--) {
  560.         *dl++ = *ll++ & *rl++;
  561.         *dl++ = *ll++ & *rl++;
  562.         *dl++ = *ll++ & *rl++;
  563.         *dl++ = *ll++ & *rl++;
  564.         }
  565.         break;
  566.     case OP_BIT_XOR:
  567.         while (len--) {
  568.         *dl++ = *ll++ ^ *rl++;
  569.         *dl++ = *ll++ ^ *rl++;
  570.         *dl++ = *ll++ ^ *rl++;
  571.         *dl++ = *ll++ ^ *rl++;
  572.         }
  573.         break;
  574.     case OP_BIT_OR:
  575.         while (len--) {
  576.         *dl++ = *ll++ | *rl++;
  577.         *dl++ = *ll++ | *rl++;
  578.         *dl++ = *ll++ | *rl++;
  579.         *dl++ = *ll++ | *rl++;
  580.         }
  581.     }
  582.  
  583.     dc = (char*)dl;
  584.     lc = (char*)ll;
  585.     rc = (char*)rl;
  586.  
  587.     len = remainder;
  588.     }
  589. #endif
  590.     {
  591.     char *lsave = lc;
  592.     char *rsave = rc;
  593.     
  594.     switch (optype) {
  595.     case OP_BIT_AND:
  596.         while (len--)
  597.         *dc++ = *lc++ & *rc++;
  598.         break;
  599.     case OP_BIT_XOR:
  600.         while (len--)
  601.         *dc++ = *lc++ ^ *rc++;
  602.         goto mop_up;
  603.     case OP_BIT_OR:
  604.         while (len--)
  605.         *dc++ = *lc++ | *rc++;
  606.       mop_up:
  607.         len = lensave;
  608.         if (rightlen > len)
  609.         sv_catpvn(sv, rsave + len, rightlen - len);
  610.         else if (leftlen > len)
  611.         sv_catpvn(sv, lsave + len, leftlen - len);
  612.         else
  613.         *SvEND(sv) = '\0';
  614.         break;
  615.     }
  616.     }
  617. }
  618.  
  619. OP *
  620. do_kv(ARGS)
  621. dARGS
  622. {
  623.     dSP;
  624.     HV *hv = (HV*)POPs;
  625.     I32 i;
  626.     register HE *entry;
  627.     char *tmps;
  628.     SV *tmpstr;
  629.     I32 dokeys =   (op->op_type == OP_KEYS);
  630.     I32 dovalues = (op->op_type == OP_VALUES);
  631.  
  632.     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
  633.     dokeys = dovalues = TRUE;
  634.  
  635.     if (!hv)
  636.     RETURN;
  637.  
  638.     (void)hv_iterinit(hv);    /* always reset iterator regardless */
  639.  
  640.     if (GIMME != G_ARRAY) {
  641.     dTARGET;
  642.  
  643.     if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
  644.         i = HvKEYS(hv);
  645.     else {
  646.         i = 0;
  647.         /*SUPPRESS 560*/
  648.         while (entry = hv_iternext(hv)) {
  649.         i++;
  650.         }
  651.     }
  652.     PUSHi( i );
  653.     RETURN;
  654.     }
  655.  
  656.     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
  657.     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
  658.  
  659.     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
  660.     while (entry = hv_iternext(hv)) {
  661.     SPAGAIN;
  662.     if (dokeys) {
  663.         tmps = hv_iterkey(entry,&i);    /* won't clobber stack_sp */
  664.         if (!i)
  665.         tmps = "";
  666.         XPUSHs(sv_2mortal(newSVpv(tmps,i)));
  667.     }
  668.     if (dovalues) {
  669.         tmpstr = NEWSV(45,0);
  670.         PUTBACK;
  671.         sv_setsv(tmpstr,hv_iterval(hv,entry));
  672.         SPAGAIN;
  673.         DEBUG_H( {
  674.         sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
  675.             HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
  676.         sv_setpv(tmpstr,buf);
  677.         } )
  678.         XPUSHs(sv_2mortal(tmpstr));
  679.     }
  680.     PUTBACK;
  681.     }
  682.     return NORMAL;
  683. }
  684.  
  685.